﻿// (c)Lyosha Alefirov, 2013
// Interpreter of language L

module LLexer
open System
open System.IO

type Id = string
type Number = int

type OperatorType =
    | Add
    | Sub
    | Mul
    | Div
    | And
    | Or
    | Eq
    | NEq
    | Less
    | Greater
    | NLess
    | NGreater

type Lexem = 
    | Id of Id 
    | Number of Number
    | Operator of OperatorType 
    | Assign
    | LBracket 
    | RBracket  
    | Semicolon
//Keywords    
    | Read
    | Write
    | If
    | Then
    | Else
    | While
    | Do
    | Skip
///////
    | EOP 
    | Error of string
    | Unknown


type Source = char list
type CurrentLexem = Lexem

type LLexer = CurrentLexem * Source
type LLexerStep = LLexer -> LLexer


let rec private separateAfter f (l : 'a list) =
    match l with
    | x::xs when f x ->
        let x1,x2 = separateAfter f xs
        (x::x1, x2)
    | _ -> ([], l)

/// Delete first whitespaces from source
let rec private trim (l : LLexer) : LLexer =
    let f c = Char.IsWhiteSpace c  
    match l with
    | cl, s::ss when f s -> trim (cl,ss)
    | _ -> l 


let private parseAssign (lexer: LLexer) =
    let _, source = lexer
    match source with
    |':'::'='::ss -> (Assign, ss)
    | _ -> (Error "Expected assign", source)

let private parseOperator (lexer : LLexer) =
    let _, source = lexer
    match source with
    | '&' :: '&' :: ss -> (Operator And, ss)
    | '|' :: '|' :: ss -> (Operator Or, ss)
    | '=' :: '=' :: ss -> (Operator Eq, ss)
    | '!' :: '=' :: ss -> (Operator NEq, ss)
    | '<' :: s :: ss ->
        match s with
        |'=' -> (Operator NGreater, ss)
        | _ -> (Operator Less, s::ss)
    | '>' :: s :: ss ->
        match s with
        |'=' -> (Operator NLess, ss)
        | _ -> (Operator Greater, s::ss)
    | _ -> (Error "Expected operator", source)

let private parseNum (lexer : LLexer) : LLexer =
    let _ , source = lexer
    let (s, ss) = separateAfter (fun c -> Char.IsDigit c) source
    let num = s |> List.map Char.GetNumericValue |> List.map int |> List.fold (fun x y -> x*10 + y) 0
    (Lexem.Number(num), ss)

let private parseWord (lexer : LLexer) : LLexer =
    let _ , source = lexer
    let (s, ss) = separateAfter (fun c -> Char.IsLetterOrDigit c) source
    let name = s |> List.fold (fun s c -> s + string c) ""
    match name.ToLower() with
    | "read" -> (Read, ss)
    | "write" -> (Write, ss)
    | "if" -> (If, ss)
    | "then" -> (Then, ss)
    | "else" -> (Else, ss)
    | "while" -> (While, ss)
    | "do" -> (Do, ss)
    | "skip" -> (Skip, ss)
    | _ -> (Id(name), ss)

let MoveNext (lexer : LLexer) : LLexer =
    let lexer = trim lexer
    match lexer with
    | _, s::ss ->
        match s with
        |'+' -> (Operator(Add), ss)
        |'-' -> (Operator(Sub), ss)
        |'*' -> (Operator(Mul), ss)
        |'/' -> (Operator(Div), ss)
        |';' -> (Semicolon, ss)
        |'(' -> (LBracket, ss)
        |')' -> (RBracket, ss)
        |':' -> parseAssign lexer
        | '&' | '|' | '=' | '!' | '<' | '>' -> parseOperator lexer
        | x when Char.IsDigit(x) -> parseNum lexer
        | x when Char.IsLetter(x) -> parseWord lexer
        | _ -> lexer
    | _, [] -> (EOP, [])

let CurrentToken (lexer : LLexer) =
    match lexer with
    |cl,_ -> cl 

///Moves lexer n-1 and returns n tokens with previous current one. Dunnow how to call it/
let rec CurrentMoveNextTokens (lexer: LLexer) n =
    match n with
    | x when x <= 0 -> [], lexer
    | _ ->
        let tokens, nxtLexer = CurrentMoveNextTokens (MoveNext lexer) (n-1)
        (CurrentToken lexer)::tokens, nxtLexer


// Combine LexerStep and something to do
let inline (+&) (ls : LLexerStep) f : LLexerStep =
    fun lexer ->
        let x = ls lexer
        f x
        x

/// Combine two LLexerSteps
let (++) (ls1 : LLexerStep) (ls2 : LLexerStep) : LLexerStep =
    fun lexer -> ls1 (ls2 lexer)

let rec many ls f =
    fun lexer ->
        if f lexer then 
            many ls f (ls lexer)
        else lexer